home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / Pocket 6.3 ƒ / Pocket DA / DA Source / dSupport.txt < prev    next >
Encoding:
Text File  |  1993-06-25  |  9.6 KB  |  362 lines  |  [TEXT/ttxt]
  1. ; this file is dSupport.txt
  2. ; Mon Feb 15, 1988 10:22:13 menus
  3. ; Thu Feb 18, 1988 00:24:50 redo the control routine structure
  4. ;                key events are now subroutines
  5. ; Wed Mar 30, 1988 13:37:36 opener routine
  6. ; Thu Apr 07, 1988 16:00:59 nested loads
  7. ; Mon Apr 18, 1988 14:06:37 restructure variables, echo, version, pblk in d4
  8. ; Mon Apr 25, 1988 15:10:34 macros
  9. ; Fri Apr 29, 1988 10:36:59 cursor change handler
  10. ; Sun May 01, 1988 10:40:36 fix emptyFS
  11. ; Tue May 10, 1988 01:28:38 ?terminal now writes event record to pad
  12. ; Sat Aug 08, 1992 19:26:00 remove xpect emitcode, add form
  13.  
  14. ; ----- Mac Data ------
  15.  
  16. theWindow:    DC.L    0        ; the DA's wptr & stuff
  17.     WContRect:    DC.W    0,0
  18.     WSize:    DC.W    WHeight,WWidth
  19.  
  20. Activate:    DC.W    drop-base    ; drop act/deact flag
  21. Update:        DC.W    curs-base
  22. Button:        DC.W    beep-base
  23. YourMenu:    DC.W    menus-base
  24. Runner:        DC.W    null-base
  25. Closer:        DC.W    null-base
  26. Version:    DC.W    doabout-base    ; the about thingy
  27. Opener:        DC.W    prompt-base    ; open routine 3/30/88
  28. Echo:        DC.W    -1
  29. MyID:        DC.W    0
  30. KeyDown:    DC.W    inKey-base    ; text input
  31. Cursor:        DC.W    null-base
  32.  
  33. oldSSize:    DC.W    0
  34. oldStackH:    DC.L    0
  35.  
  36. TextO:        DC.L    0
  37. TextE:        DC.L    0
  38. TextH:        DC.L    0
  39. FStack:        DCB.L    5,0        ; text block handles
  40. FOfsets:    DCB.L    5,0        ; text block offsets
  41. FEnds:        DCB.L    5,0        ; text block ends
  42. FSPtr:        DC.W    -4        ; file stack pointer
  43.  
  44. Events:        DC.W    return-base    ; null event
  45.         DC.W    buttDnEvt-base
  46.         DC.W    return-base    ; button up
  47.         DC.W    keyDnEvt-base
  48.         DC.W    return-base    ; key up
  49.         DC.W    keyDnEvt-base    ; auto key
  50.         DC.W    UpdateEvt-base
  51.         DC.W    return-base    ; disk inserted
  52.         DC.W    ActivateEvt-base
  53.         
  54. Registers:    DCB.L    6,0        ; save Dict/Counter/DP-IS/PS
  55. PStackH:    DC.L    0
  56.  
  57. oldKeyDown:    DC.W    0        ; hold key handler addr during key
  58. Scratch:    DC.L    0
  59.  
  60. Menus:        DC.W    emenu-base
  61.         DC.W    emenu-base
  62. EMenu:        DC.W    beep-base    ; undo
  63.         DC.W    null-base    ; -
  64.         DC.W    beep-base    ; cut
  65.         DC.W    beep-base    ; copy
  66.         DC.W    paste-base    ; paste
  67.         DC.W    beep-base    ; clear
  68.  
  69. ; ----- Forth's Data ------
  70.  
  71. TermBuf:    DCB.B    84,32        ; the input line buffer
  72. IntA7:        DC.L    0        ; applications rStack
  73. RZero:        DC.L    0        ; empty rStack
  74. UFlow:        DC.L    0        ; pstack underflow buffer (2bytes)
  75. SZero:        DC.L    0        ; empty pStack
  76. Expand:        DC.L    0        ; abs.addr in locked DRVR
  77. FreePt:        DC.W    DictEnd-base    ; "here"'s relative addr
  78. FreeSz:        DC.W    base+32767-dictend    ; number of bytes available
  79. DictPt:        DC.W    task-theLink    ; last word defined
  80. NBase:        DC.W    10        ; number base
  81. Held:        DC.W    0        ; HLD address
  82. DoesAddr:    DC.L    0        ; "does>" jump address
  83. fcolon:        DC.B    0        ; defining flag
  84. fimmed:        DC.B    0        ; immediate definition flag    
  85. fneg:        DC.B    0        ; negative sign flag
  86. fint:        DC.B    $80        ; key or clipboard
  87. fmacro:        DC.W    0        ;   macro flag+filler
  88. Form:        DC.L    $FFFF0007    ; decaform record
  89.  
  90. DictControl:    ; ----- Control routine ------
  91.     JSR    SetFRegs        ; set the Forth registers    
  92.     MOVE.L    A7,IntA7-base(BP)    ; put return address in IntA7
  93.     SUBA.L    #16,A7            ; allocate a underflow buffer
  94.     MOVE.L    A7,Rzero-base(BP)
  95.     MOVE.L    theWindow-base(BP),-(SP)
  96.     _SetPort            ; set this window
  97.  
  98.     MOVE.L    D4,A0            ; A0 has the param block's address
  99.     MOVE    csCode(A0),D0        ; d0 has the message
  100.  
  101.     ; Event Message
  102.     CMPI    #accEvent,D0        ; event message?
  103.     BNE.S    @0
  104.     MOVEA.L    csEvent(A0),A0        ; get the event record
  105.     MOVE    evtNum(A0),D0        ; get event in D0
  106.     ANDI    #$0F,D0
  107.     ADD    D0,D0
  108.     LEA    Events-base(BP),A1    ; jump to: ...
  109.     MOVE    0(A1,D0.W),D0        ;  ... ActivateEvt, ButtDnEvt, ...
  110.     JMP    0(BP,D0.W)        ;  ... UpDateEvt or KeyDnEvt
  111.     
  112.     ; Idle Message
  113.     @0:    CMPI    #accRun,D0        ; periodic run message?
  114.     BNE.S    @1
  115.     MOVE    Runner-base(BP),D0
  116.     BRA.S    @5            ; jump to the idle handler
  117.     
  118.     ; cursor message
  119.     @1:    CMPI    #accCursor,D0        ; change cursor message?
  120.     BNE.S    @2
  121.     MOVE    cursor-base(BP),D0
  122.     BRA.S    @5            ; jump to the cursor handler
  123.     
  124.     ; Menu Message
  125.     @2:    CMPI    #accMenu,D0        ; menu message
  126.         BNE.S    @3
  127.     MOVE    csMenu(A0),D0        ; D0 has the item number
  128.     SUBQ    #1,D0            ; D0 has the item index
  129.     ADD    D0,D0            ; D0 has menu list offset
  130.     MOVE    Yourmenu-base(BP),D1    ; D1 has menus relative addr
  131.     BRA.S    @4            ; execute the menu
  132.  
  133.     ; Edit message
  134.     @3:    CMPI    #accUndo,D0        ; edit menu message?
  135.     BMI.S    return
  136.     SUBI    #accUndo,D0        ; normalize message# to 0-5
  137.     ADD    D0,D0            ; D0 has offset into emenu
  138.     MOVE    Yourmenu-base(BP),D1    ; D1 has menus relative addr
  139.     ADDQ    #2,D1            ; D1 has menus+2 rel addr
  140.  
  141.     @4:    MOVE    0(BP,D1.W),D1        ; D1 has emenu rel addr
  142.     ADD    D1,D0            ; D0 has emenu+offset rel addr
  143.     MOVE    0(BP,D0.W),D0        ; D0 has the handler' rel addr
  144.     @5:    JSR    0(BP,D0.W)        ; execute subroutine
  145.  
  146. Return:    JSR    SaveFRegs-base(BP)    ; save the current forth registers
  147.     MOVE.L    IntA7-base(BP),A7    ; restore the return address
  148.     RTS                ; and go back to the DRVR
  149.  
  150. ; First Line Event Handlers
  151.  
  152. ActivateEvt:
  153.     MOVE    evtMeta(A0),-(PS)
  154.     ANDI    #1,(PS)
  155.     MOVE    Activate-base(BP),D0
  156.     BRA.S    revt
  157.  
  158. ButtDnEvt:
  159.     MOVE    Button-base(BP),D0
  160.   revt:    JSR    0(BP,D0.W)
  161.     BRA.S    return
  162.  
  163. UpDateEvt:
  164.     MOVE.L    thewindow-base(BP),-(SP)
  165.     MOVE.L    (SP),-(SP)
  166.     _BeginUpdate
  167.     MOVE    update-base(BP),D0
  168.     JSR    0(BP,D0.W)
  169.     _EndUpdate
  170.     BRA.S    return
  171.     
  172. KeyDnEvt:
  173.     MOVE.W    evtASCII(A0),-(PS)    ; push key data
  174.     MOVE    Keydown-base(BP),D0
  175.     JSR    0(BP,D0.W)        ; jump to the vector
  176.  kDone:    BSR.S    Curs            ; draw the cursor
  177.     BRA.S    return
  178.  
  179. ; Un-named subroutines
  180.  
  181. SaveFRegs:
  182.     LEA    Registers-base(BP),A0
  183.     MOVEM.L    D6-D7/A2-A4/A6,(A0)
  184.     RTS
  185.  
  186. SetFRegs:    ; restore the forth registers
  187.     LEA    Registers,A0
  188.     MOVEM.L    (A0),D6-D7/A2-A4/A6
  189.     RTS
  190.         
  191. TextNormal:
  192.     _PenNormal            ; 1X1, black, patcopy
  193.     MOVE    #4,-(SP)        ; Monaco
  194.     _TextFont
  195.     MOVE    #0,-(SP)        ; plain text
  196.     _TextFace
  197.     MOVE    #9,-(SP)        ; 9 point
  198.     _TextSize
  199.     MOVE    #0,-(SP)        ; srcCopy
  200.     _TextMode
  201.     RTS    
  202.     
  203. NoCurs:    MOVE    #10,-(SP)        ; SrcXor mode
  204.     _PenMode
  205.   Curs:    MOVE.L    #$00000006,-(SP)    ; move 6 pixels to the right
  206.     _Move
  207.     MOVE.L    #$0000FFFA,-(SP)    ; draw 6 pixels to the left
  208.     _Line
  209.     _PenNormal
  210.     RTS
  211.  
  212. altKey:    BSR.S    TextNormal        ; font, mode, size etc
  213.     BSR.S    NoCurs            ; erase the cursor
  214.     MOVE    oldKeyDown-base(BP),KeyDown-base(BP) ; set old key vector
  215.     BSR.S    RestoreRStack        ; put pforth addrs on rstack
  216.     MOVE.L    oldStackH-base(BP),A0
  217.     MOVEQ    #0,D0
  218.     _SetHandleSize            ; shrink old stack data block
  219.     ANDI    #$FF,(PS)        ; mask out ascii
  220.     RTS                ; return from "key"
  221.  
  222. RestoreRStack:
  223.     MOVE.L    (SP)+,A1        ; save calling address
  224.     MOVE.L    oldStackH-base(BP),A0
  225.     MOVE.L    (A0),A0            ; get addr of old stack data block
  226.     MOVEQ    #0,D0
  227.     MOVE    oldSSize-base(BP),D0    ; get size of block to move
  228.     ADD.L    D0,A0
  229.     @0: MOVE.L    -(A0),-(SP)
  230.     SUBQ.L    #4,D0
  231.     BGT.S    @0
  232.     JMP    (A1)            ; return to calling address
  233.  
  234. QTCode:        ; "?terminal" code
  235.     CLR    -(SP)            ; ?terminal's routine
  236.     MOVE    #40,-(SP)        ; test just for keypresses
  237.     PEA    40(DP)            ; put the data at 'pad'
  238.     _EventAvail
  239.     MOVE    (SP)+,-(PS)
  240.     MOVE.L    #$0000FFFF,D0
  241.     _FlushEvents            ; all events out!
  242.     RTS
  243.  
  244. KeyCode:    ; "key" code
  245.     MOVE.L    RZero-base(BP),D5
  246.     SUB.L    SP,D5
  247.     MOVEQ    #0,D0
  248.     MOVE    D5,D0
  249.     MOVE    D0,oldSSize-base(BP)    ; set old stack size
  250.     MOVE.L    oldStackH-base(BP),A0
  251.     _SetHandleSize
  252.     MOVE.L    (A0),A0            ; A0 points to old stack data block
  253.     @0:    MOVE.L    (SP)+,(A0)+        ; save RStack
  254.     SUBQ    #4,D5
  255.     BGT.S    @0
  256.     MOVE    KeyDown-base(BP),oldKeyDown-base(BP)  ; save the old keydown
  257.     MOVE    #altKey-base,keydown-base(BP)    ; reset key handler
  258.     JMP    kDone-base(BP)            ; return to application
  259.  
  260. ClearTermBuf:
  261.     MOVEQ    #76,D0
  262.     LEA    TermBuf-base(BP),IS
  263.     @0:    MOVE.L    #$20202020,0(IS,D0)    ; fill line buffer with blanks
  264.     SUBQ.B    #4,D0
  265.     BGE.S    @0
  266.     RTS
  267.  
  268. EmptyFS: ; clear pending loads from the file stack
  269.     TST    fsptr-base(BP)
  270.     BMI.S    @1
  271.     LEA    fstack-base(BP),A1
  272.     MOVE    fsptr-base(BP),D0
  273.     MOVE.L    0(A1,D0),A0
  274.     CLR.L    0(A1,D0)
  275.     MOVE.L    A0,D1            ; dont try to dispose of nil handle*
  276.     BEQ.S    @0            ; *
  277.     CMPA.L    TextH-base(BP),A0
  278.     BEQ.S    @0
  279.     _DisposHandle
  280.     @0:    SUBQ    #4,fsptr-base(BP)
  281.     BRA.S    emptyfs
  282.     @1:    RTS
  283.  
  284. Paste:    JSR    nocurs-base(BP)
  285.     CLR.L    -(SP)
  286.     MOVE.L    TextH-base(BP),-(SP)    ; handle to the scrap data
  287.     MOVE.L    #'TEXT',-(SP)
  288.     PEA    TextO-Base(BP)
  289.     _GetScrap
  290.     MOVE.L    (SP)+,TextE-base(BP)    ; put the length at TextE
  291.     MOVE.L    TextH-base(BP),A0    ; get a handle to the scrap data
  292.     MOVE.L    (A0),D0            ; derefrence the scrap handle
  293.     MOVE.L    D0,TextO-base(BP)    ; set TextO to start of scrap data
  294.     ADD.L    D0,TextE-base(BP)    ; set TextE to end of scrap data
  295.     _HLock                ; don't let data move during paste
  296.     CLR    fsptr-base(BP)
  297.     MOVE.L    TextH-base(BP),fstack-base(BP)
  298.     MOVE.L    TextO-base(BP),fofsets-base(BP)
  299.     MOVE.L    TextE-base(BP),fends-base(BP)
  300.     go:    CLR.B    fint-base(BP)        ; leave keyboard mode
  301.     JMP    CRet-base(BP)        ; get next line
  302.  
  303. Pasting:
  304.     JSR    ClearTermBuf-base(BP)
  305.     CLR.L    D5            ; clear the character count
  306.     CLR.L    D0            ; and the character
  307.     MOVE.L    TextO-base(BP),A0    ; set the input address
  308.     @0:    MOVE.B    0(A0,D5.W),D0        ; BEGIN  get a character
  309.     CMP.B    #CR,D0            ;     is it not a CR?
  310.     BEQ.S    @1
  311.     CMPI.B    #78,D5            ;     or 78 characters in buffer
  312.     BGE.S    @1            ; WHILE
  313.         MOVE.B    D0,0(IS,D5)        ;     stash it into buffer
  314.     ADDQ.B    #1,D5            ;     increment count
  315.     BRA.S    @0            ; REPEAT
  316.     @1:    ADDQ.B    #1,D5            ; increment count
  317.     MOVE.B    #CR,0(IS,D5)        ; stash CR into buffer
  318.     MOVE    D5,D0            ; preserve count for TYPE
  319.     ADD.L    TextO-base(BP),D0
  320.     MOVE.L    D0,TextO-base(BP)    ; TextO=TextO+char.count
  321.     CMP.L    TextE-base(BP),D0    ; IS the block done (TextO≥TextE)?
  322.     BMI.S    tandr            ; just type and return if not.
  323.     
  324.     MOVE    fsptr-base(BP),D0
  325.     LEA    fstack-base(BP),A0
  326.     MOVE.L    0(A0,D0.W),A0
  327.     _HUnlock            ; unlock the block
  328.     CMPA.L    TextH-base(BP),A0
  329.     BEQ.S    @2            ; keep the scrap block
  330.  
  331.     _DisposHandle            ; dispose of loaded blocks
  332.     @2:    SUBQ    #4,fsptr-base(BP)    ; pop fstack
  333.     BMI.S    @3            ; branch if no pending loads
  334.  
  335.     MOVE    fsptr-base(BP),D0
  336.     LEA    fofsets-base(BP),A0    ; set TextO to (fofsets+fsptr)
  337.     MOVE.L    0(A0,D0.W),TextO-base(BP)
  338.     LEA    fends-base(BP),A0
  339.     MOVE.L    0(A0,D0.W),TextE-base(BP)
  340.     BRA.S    tandr
  341.  
  342.     @3:    BSET.B    #7,fint-base(BP)    ; set keyboard mode
  343.  tandr:    TST    echo-base(BP)
  344.     BNE.S    @4
  345.     RTS
  346.     
  347.     @4:    JSR    tib-base(BP)
  348.     MOVE    D5,-(PS)
  349.     JSR    type-base(BP)
  350.     JMP    doCR-base(BP)        ; TIB count TYPE CR ;
  351.  
  352. DoAbout:
  353.     CLR.L    -(SP)
  354.     MOVE.L    #'p4TH',-(SP)
  355.     MOVE    myid-base(BP),-(SP)    ; Resource ID of p4TH
  356.     _GetResource
  357.     MOVE.L    (SP),A0
  358.     MOVE.L    (A0),-(SP)        ; text address
  359.     _DrawString
  360.     _ReleaseResource
  361.     JMP    docr-base(BP)
  362.